home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / LISP04.ARJ / PLIST.LSP < prev   
Text File  |  1989-12-08  |  3KB  |  65 lines
  1. ;10.  Draws a parts list and prompts for the
  2. ;     parts.
  3. (Defun C:Plist (/ P1 P2 P3 P4 P5 A1 A B C D E F)
  4.        (Setvar "Cmdecho" 0)
  5.        (Setq F (Getvar "Blipmode"))
  6.        (Setvar "Blipmode" 0)
  7.        (prompt "\n ********* BE SURE YOU HAVE RUN SETUP!! ******")
  8.        (prompt "\n ********* Just Type SETUP ******")
  9.        (Setq A (Getvar "userr1"))
  10.        (Setq B (Getint "\nEnter number of items in list: "))
  11.        (Setq P1 (Osnap (Getpoint "\nTouch upper right corner of
  12. drawing: ")
  13.                  "End")
  14.        )
  15.        (Command "Insert" "Plist" P1 (/ A 1) "" "0")
  16.        (Setq P1 (List (- (Car P1) (* 0.34375 A)) (- (Cadr P1) (*
  17. 0.31250 A))))
  18.        (Setq P2 (List (- (Car P1) (* 5.09375 A)) (Cadr P1)))
  19.        (Setq P3 (List (- (Car P2) (* 1.00 A)) (Cadr P2)))
  20.        (Setq P4 (List (- (Car P3) (* 0.4375 A)) (Cadr P3)))
  21.        (Setq P5 (List (- (Car P4) (* 0.625 A)) (+ (Cadr P4) (*
  22. 0.3125 A))))
  23.        (Setq A1 (* 1.5 Pi)) (Setq D (* 0.25 A))
  24.        (Setq E (+ (* 0.3125 A) (* D B)))
  25.        (Command "Line" P1 (Polar P1 A1 E) "")
  26.        (Command "Line" P2 (Polar P2 A1 E) "")
  27.        (Command "Line" P3 (Polar P3 A1 E) "")
  28.        (Command "Line" P4 (Polar P4 A1 E) "")
  29.        (Command "Line" P5 (Polar P5 A1 (+ (* 0.6250 A) (* D B)))
  30. "")
  31.        (Setq P1 (Polar P5 A1 (* 0.875 A)))
  32.        (Command "Line" P1 (Polar P1 0 (* 7.5 A)) "")
  33.        (Command "Array" "L" "" "R" B "" (* -1 D))
  34.        (Setq P1 (List (+ (Car P1) (* 0.3125 A)) (+ (Cadr P1) (*
  35. 0.0625 A))))
  36.        (Setq P2 (Polar P1 0 (* 0.53125 A)))
  37.        (Setq P3 (Polar P2 0 (* 0.71875 A)))
  38.        (Setq P4 (Polar P3 0 (* 0.5625 A)))
  39.        (Setq P5 (Polar P4 0 (* 5.203125 A)))
  40.        (Setq C 1)
  41.        (Repeat B
  42.                (Command "Text" "C" P1 (* 0.125 A) "0" (Itoa C))
  43.                (Prompt "\nQuantity for item ")
  44.                (Princ C)
  45.                (Prompt ": ")
  46.                (Setq G (Read-line))
  47.                (Command "Text" "C" P2 (* 0.125 A) "0" G)
  48.                (Prompt "\nPart number for item ")
  49.                (Princ C) (Prompt ": ") (Setq G (Read-line))
  50.                (Command "Text" "C" P3 (* 0.125 A) "0" G)
  51.                (Prompt "\nDescription for item ")
  52.                (Princ C) (Prompt ": ") (Setq G (Read-line))
  53.                (Command "Text" P4 (* 0.125 A) "0" G)
  54.                (Prompt "\nDrawing size for item ")
  55.                (Princ C) (Prompt ": ") (Setq G (Read-line))
  56.                (Command "Text" P5 (* 0.125 A) "0" G)
  57.                (Setq P1 (List (Car P1) (- (Cadr P1) D)))
  58.                (Setq P2 (List (Car P2) (- (Cadr P2) D)))
  59.                (Setq P3 (List (Car P3) (- (Cadr P3) D)))
  60.                (Setq P4 (List (Car P4) (- (Cadr P4) D)))
  61.                (Setq P5 (List (Car P5) (- (Cadr P5) D)))
  62.                (Setq C (+ 1 C))
  63.        )
  64.        (Setvar "Blipmode" F)
  65. )